#!/usr/bin/perl -w

package Wallpaper;

=head1 NAME

wallpaper - Randomized X Backgrounds based on time of day

=head1 DESCRIPTION

This script does many things.  Much of the documenation has been purged from
this file and moved to
L<http://wiki.archlinux.org/index.php/Perl_Background_Rotation>.

Please read that wiki page first before diving too deeply into this script.

=head1 DEPENDENCIES

L<Image::Magick>, L<Color::Scheme>, L<DB_File>

=cut

use Image::Magick;
use Color::Scheme;
use IPC::Shareable;
use DB_File;

=head1 GLOBAL VARIABLES

Need to clean this up...

=cut

my ( $second, $minute, $hour, $dayOfMonth, $month, $yearOffset, $dayOfWeek, $dayOfYear, $daylightSavings ) = localtime();
my ( @files, $selected, $total, $new, $dir, $previous, $current, $next, $colorscheme, $background, $runstatus );
our ( %config, $finished );

my $image = Image::Magick->new;

=head1 INITIALIZATION

Describe...

=cut

&setdefaults;    # Set Default options and read user config
use strict;
my $photodir = "$config{'bgdir'}/$config{'photoset'}[$hour]/";
&sanity_check;    # Are we good to go?

=head1 MAIN PROGRAM

The main execution is fairly simple.  It checks the commandline, the runstatus,
and figures out the previous, current, and next photos.  It's final task (if the
program is still running) is to call a function called chooser.

=cut

&checkargs( @ARGV ) if @ARGV;    # Handle commandline arguments

# Abort if status is set to stop

$runstatus = &datastore( 'get', 'status' );
&datastore( 'set', 'status', 'run' ) if ( ! $runstatus ); # Set to run if new database
if ( $runstatus eq "stop" ) {
    print "\nScript halted, status of script is: $runstatus\n" if $config{ 'debug' };
    exit;
}

$previous = &datastore( 'get', 'current' );    # Get previously selected photo
$current  = &datastore( 'get', 'next' );       # Get current the photo to work with

my @toselect = getdir( $photodir );            # Get a list of files to choose from
$selected = randomfile( \@toselect, $current );    # Pick a new image for upcoming photo
$next = $photodir . $selected;                     # Full path to new image

&datastore( 'set', 'next', $next );                # Set the next photo to use next run
print "Next photo to use will be $next\n" if $config{ 'debug' };
&datastore( 'set', 'current', $current );          # Record current filename
print "Using photo $current\n" if $config{ 'debug' };

&chooser( $current, $next );

exit( 0 );

=head1 FUNCTIONS

=over 4

=item * chooser

chooser accepts two parameters, the current and next filename.  Depending on the
user configuration, it then creates an imagemagick object or two, calls
appropriate user-selected functions and calls a function to display the photo.

=cut

sub chooser {
    my ( $current, $next ) = @_;

    if ( $config{ 'mangle' } or $config{ 'conky' } or $config{ 'urxvt_pixmaps' } ) {
        $image->Read( $current );    # Read in image for current file
    }

    if ( $config{ 'mangle' } ) {
        $image->Read( $next );       # Read in image for upcoming photo
        &domangle( $current );       # Mangle!
    }

    &doterminal( $current ) if $config{ 'urxvt_pixmaps' };    # Create urxvt background
    &conkytweak             if $config{ 'conky' };            # Tweak conky configuration
    &dosetroot( $current, $next );                            # Set the root background(s)

    print " WHACK!\n" if $config{ 'debug' };
    #unlink( "/dev/shm/done.png" );
    exit ( 0 );

} ## end sub chooser

=item * domangle

domangle is a function that is probably only useful to myself.  It's incredibly
complex at the moment, and will probably be optimized in the near future.

It accepts only one parameter, the filename (full pathname), to mangle.  An
imagemagick object should allready have been defined for both the mangle image,
and the next image by the time this function is called.

It first creates a new ImageMagick object for the 'new' background, and then
performs some scaling to ensure that our selected image is high and wide enough
for our image block.  It then retrieves the new width and height, and determines
how much to crop from our image.  

If a filename is prefixed with "Right_", it is assumed that you want to preserve
content on the Right side and the LEFT area is then cropped from the image.  The
same holds true for Photos prefixed with Left_ and Center_.  A special Exception
is photos prefixed with Tile_, which are tiled across the photo area.  Works
great for those old Propoganda tiles.

Once cropped, a 2 pixel black border is added.  Then the bottom and left borders
are chopped off.  Finally, the entire image is composited onto tho blue
background and saved.

THEN, the upcoming photo is resized, has borders added and is copied several
times and rotated slightly.  A shadow mask is created, and the mask is
composited onto the background.  Then the composite of the next photos is
composited on on top of the whole mess.  It that weren't enough, a annotation
(text) is inserted with a border, then inserted again filled with the proper
colors.

=cut

sub domangle {
    print "Performing Imange Mangle\n" if $config{ 'debug' };
    my ( $manglefilename ) = @_;

    # This is a bit extreme, i know!
    my ( $height, $width, $original, $res_width, $res_height, $cropped_width, $cropped_height );
    my ( $cropped_width_noborder, $cropped_height_noborder, $double_border, $border_geo, $chop_geo );
    my ( $widthcut, $heightcut, $chop );
    my ( $backtile, $nextfiller, $backcolor, $bordercolor );
    my ( $nextphoto, $nextphoto2, $nextphoto3, $nextphoto4, $nextphoto5, $nextshadow );

    ( $res_width, $res_height ) = $config{'resolution'} =~ /^(\d+)x(\d+)/;

    print "\tResolution set to : " . $res_width . "x" . $res_height . "\n" if $config{ 'debug' };

    # The size of the cropped image (with borders)
    $cropped_width  = $res_width - $config{ 'conky_width' };
    $cropped_height = $res_height - $config{ 'bar_height' };
    
    print "\tCropped image size : " . $cropped_width . "x" . $cropped_height . "\n" if $config{ 'debug' };

    # The size of the cropped image (without borders)
    $cropped_width_noborder  = $cropped_width - $config{ 'border_size' };
    $cropped_height_noborder = $cropped_height - $config{ 'border_size' };
    
    print "\tCropped noborder size : " . $cropped_width_noborder . "x" . $cropped_height_noborder . "\n" if $config{ 'debug' };

    $double_border = $config{ 'border_size' } + $config{ 'border_size' };

    $border_geo = $config{ 'border_size' } . "x" . $config{ 'border_size' };
    $chop_geo   = $double_border . "x" . $double_border . "+0+" . $cropped_height;
    
    print "\tBorder Geometry : " . $border_geo . "\n" if $config{ 'debug' };

    # Original photo already read                            # [0] Original photo
    # Next photo alredy read                                 # [1] Next photo
    $image->Read( $config{ 'bgdir' } . '/backtile.jpg' );    # [2] Read in conky background tile image
    $image->Read( $config{ 'bgdir' } . '/blank.png' );       # [3] Read in placeholder for background (1x1 tranparent png)
    $image->Read( $config{ 'bgdir' } . '/blank.png' );       # [4] Read in placeholder for tiles (if needed)
    $image->Read( $config{ 'bgdir' } . '/blank.png' );       # [5] Read in placeholder for nextimage collage

    if ( $manglefilename !~ /Tile_.*/ ) {                    # Image is not tiled
        $original = $image->[0];                             # [0] is the photo selected earlier in script, create a ref
        
        $height = $original->Get( 'height' );
        if ( $height < $cropped_height ) {
            print "Height needs to be adjusted, increasing height to $cropped_height\n" if $config{ 'debug' };
            $original->Scale( geometry => "10000x" . $cropped_height );    # Width set impossibly high, so we get enough
        }

        $width = $original->Get( 'width' );
        if ( $width < $cropped_width ) {
            print "Width needs to be adjusted, increasing width to $cropped_width\n" if $config{ 'debug' };
            $original->Scale( geometry => $cropped_width . "x10000" );     # Height set impossibly high, so we get enough
        }
        
        $height = $original->Get( 'height' );                              # Reset
        $width  = $original->Get( 'width' );                               # Reset

        print "Resized image is $width x $height\n" if $config{ 'debug' };
        $widthcut  = $width - $cropped_width_noborder;
        $heightcut = $height - $cropped_height_noborder;

        if ( $manglefilename =~ /Right_.*/ ) {
            $chop = $widthcut;
            print "Image filename says to preserve right area, cutting $chop pixels from the LEFT side\n" if $config{ 'debug' };
        } elsif ( $manglefilename =~ /Left_.*/ ) {
            $chop = 0;
            print "Image filename says to preserve left area, cutting $chop pixels from the RIGHT side\n" if $config{ 'debug' };
        } elsif ( $manglefilename =~ /Center_.*/ ) {
            $chop = $widthcut / 2;
            print "Image filename says to preserve Center, cutting $chop pixels from the RIGHT and LEFT sides\n" if $config{ 'debug' };
        } else {
            $chop = $widthcut;
            print "Image does not indicate area to save, cutting $chop pixels from the LEFT side\n" if $config{ 'debug' };
        }
        $original->Crop( geometry => $cropped_width . "x" . $cropped_height . "+" . $chop . "+0" );

    } else {    # We have a tile! Do our magick
        $original = $image->[4];    # Original is blank tiled image ( not [0]! )
        $original->Resize( geometry => "!" . $cropped_width . "x " . $cropped_height );    # Create a large container for the collage
        $original->Texture( Texture => $image->[0] );                                      # Texture "original" onto blank tile
    }

    $nextphoto  = $image->[1];                                                             # Reference to the nextphoto (for collage)
    $backtile   = $image->[2];                                                             # Reference to the conky background tile
    $background = $image->[3];                                                             # Reference to the blank background
    $background->Set( size => $res_width . "x" . $res_height );
    $nextfiller = $image->[5];                                                             # Reference to the blank next filler collage

    $colorscheme = getscheme( $original ) if ( !$colorscheme );                            # Get a color scheme if we dont have it allread

    $backcolor   = "#" . $colorscheme->[0][0];                                             # Fill color = picture mean
    $bordercolor = "#" . $colorscheme->[0][1];                                             # Border color is a slightly darker picture mean

    $original->Border( fill => $bordercolor, geometry => $border_geo );                    # Add a border to cropped photo
    $original->Chop( geometry => $chop_geo );                                              # Now cut bottom/left borders off.

    $background->Texture( Texture => $backtile );                                          # Fill background with background tile
    $background->Colorize(
           fill    => $backcolor,                                                             # Overlay background color, obscuring *most* of the tile
           opacity => '92'                                                                    # makes for a nice subtle texture effect.
                         );
    $background->Composite(
               image   => $original,                                                              # Plaster original photo on our prepared background.
               compose => 'atop',
               gravity => 'SouthWest'
                          );

    # This is pretty hairy.
    $nextfiller->Resize( geometry => $config{ 'collage_container_geo' } );                 # Create a large container for the collage
    $nextphoto->Resize( geometry  => $config{ 'collage_photo_geo' } );                     # Resize the next photo brutally, forget chopping
    $nextphoto->Border( geometry => $config{ 'collage_border1_geo' }, fill => $config{ 'collage_border1_col' } );
    $nextphoto->Border( geometry => $config{ 'collage_border2_geo' }, fill => $config{ 'collage_border2_col' } );

    $nextphoto2 = $nextphoto->Clone();                                                     # Clone it! YAH!
    $nextphoto3 = $nextphoto->Clone();
    $nextphoto4 = $nextphoto->Clone();
    $nextphoto5 = $nextphoto->Clone();

    # Now we rotate our clones and composite them in the collage container
    $nextphoto2->Rotate( degrees => &rotate, color => 'none' );
    $nextfiller->Composite( image => $nextphoto2, compose => 'SrcOver' );

    $nextphoto3->Rotate( degrees => &rotate, color => 'none' );
    $nextfiller->Composite( image => $nextphoto3, compose => 'SrcOver' );

    $nextphoto4->Rotate( degrees => &rotate, color => 'none' );
    $nextfiller->Composite( image => $nextphoto4, compose => 'SrcOver' );

    $nextphoto5->Rotate( degrees => &rotate, color => 'none' );
    $nextfiller->Composite( image => $nextphoto5, compose => 'SrcOver' );

    # Now make a shadow mask of the whole mess created above
    $nextshadow = $nextfiller->Clone();
    $nextshadow->Set( background => 'black' );
    $nextshadow->Shadow( opacity => '50', sigma => '2' );

    # And place the mask and collage down on the background.
    $background->Composite( image   => $nextshadow,
                            compose => 'atop',
                            gravity => 'SouthEast',
                            x       => '0',
                            y       => '-8'
                          );

    $background->Composite( image   => $nextfiller,
                            compose => 'atop',
                            gravity => 'SouthEast',
                            x       => '8',
                            y       => '0'
                          );

    # Now lets place some descriptive text down... (this is the shadow mask)
    $background->Annotate( font        => $config{ 'displayfont' },
                           pointsize   => $config{ 'fontsize' },
                           fill        => "#" . $colorscheme->[0][3],
                           stroke      => "#" . $colorscheme->[0][1],
                           strokewidth => 1,
                           gravity     => 'SouthEast',
                           x           => $config{ 'font_x' },
                           y           => $config{ 'font_y' },
                           text        => $config{ 'collage_text' }
                         );

    # And plaster the mask with the real text.
    $background->Annotate( font      => $config{ 'displayfont' },
                           pointsize => $config{ 'fontsize' },
                           fill      => "#" . $colorscheme->[0][3],
                           stroke    => 'none',
                           gravity   => 'SouthEast',
                           x         => $config{ 'font_x' },
                           y         => $config{ 'font_y' },
                           text      => $config{ 'collage_text' }
                         );

    # Done! Write it!
    $background->Write( filename => '/dev/shm/done.png', compression => 'None' );

    $finished = 1;    # Set a flag so that other functions know he have a finished photo in $background.

} ## end sub domangle

=item * doterminal

doterminal accepts one parameter, the complete path to the photo to manipulate.
It then determines if a valid imagemagick object exists on which to operate and
assigns a reference to it.  It calls colorscheme to grab a scheme of colors, and
begins to colorize and blur the image. 

It's final task is to clean out old terminal images and write out the new one.

=cut

sub doterminal {
    my ( $original ) = @_;
    my ( $backcolor, $bordercolor, $imageref );

    if ( $finished ) {
        $imageref = $background;    # We have a mangled image, so alias it to $imageref
    } else {
        $imageref = $image->[0];    # Otherwise, just use the original photo
    }

    $colorscheme = getscheme( $original ) if ( !$colorscheme );    # Get a color scheme if we dont have it allread

    $backcolor   = "#" . $colorscheme->[0][0];                     # Fill color = picture mean
    $bordercolor = "#" . $colorscheme->[0][1];                     # Border color is a slightly darker picture mean

    # Terminal Backgrounds, blur effect looks very cool
    $imageref->Colorize( fill    => $backcolor,
                         opacity => $config{ 'urxvt_theme_op' } );
    $imageref->Colorize( fill    => '#000000',
                         opacity => $config{ 'urxvt_black_op' } );
    $imageref->Blur( channel => 'All',
                     sigma   => $config{ 'urxvt_blur' } );


    my $urxvt_filename = $config{ 'urxvt_pixmap_dir' } . "/" . $hour . $minute . $second . ".xpm";

    # Clean up old urxvt photo photos, (they get large)
    if ( $config{ 'urxvt_pixmap_dir' } ) {
        if ( !-d $config{ 'urxvt_pixmap_dir' } ) {
            mkdir( $config{ 'urxvt_pixmap_dir' }, 0755 ) || die "Cannot mkdir newdir: $!";
            print "Cleated $config{'urxvt_pixmap_dir'}\n" if $config{ 'debug' };
        } else {
            my @rxvt_dir = getdir( $config{ 'urxvt_pixmap_dir' } );
            for my $pic ( @rxvt_dir ) {
                my $file = $config{ 'urxvt_pixmap_dir' } . "/" . $pic;
                unlink( $file );
            }
        } ## end else [ if ( !-d $config{ 'urxvt_pixmap_dir'...
    } ## end if ( $config{ 'urxvt_pixmap_dir'...

    # Write xpm apas, so we dont lose pixmap in urxvt.
    $imageref->Write( filename => $urxvt_filename );
    #&datastore( 'set', 'urxvt_pixmap', $urxvt_filename );    # Record terminal pixmap image
    
    # Update shared memory vars
    my $glue = 'wallpaper';
    my %options = (
        create    => 0,
        exclusive => 0,
        mode      => 0644,
        destroy   => 0,
        );

    tie my %SHARED, 'IPC::Shareable', $glue, { %options } or die "shared memory: tie failed\n";
    $SHARED{'current'} = $urxvt_filename;

} ## end sub doterminal

=item * dosetroot

dosetroot simply displays your selected images using the tool of choice.  It accepts two
parameters, the current and next image to display.  Both parameters must be
complete filenames.

imagemagick *can* be used to set the root background, however many of the
alternatives are easier to use for end users.

=cut

sub dosetroot {
    my ( $currentfilename, $nextfilename ) = @_;

    if ( $config{ 'mangle' } ) {
        system( "$config{'display'} $config{'exe_scale'} /dev/shm/done.png" );
    } else {
        system( "$config{'display'} $config{'exe_scale'} $currentfilename" );
    }

    if ( $config{ 'displaytwo' } ) {
        if ( $nextfilename !~ /^Tile.*/ ) {    # Not tiled, great!, scale!
            system( "$config{'displaytwo'} $config{'exe_scale'} $nextfilename" );
        } else {
            system( "$config{'displaytwo'} $config{'exe_tile'} $nextfilename" );
        }
    }
} ## end sub dosetroot

=item * datastore

Parameters are (in order), (set|get), hashkey, hashkeyvalue.  This function
makes a connection the the datastore (a berkley db file) and either stores or
retrieves data.

It *could* be optimized for speed some, but it's so fast anyway - I probably
wont bother.

=cut

sub datastore {
    my ( $action, $type, $value ) = @_;

    tie my %database, 'DB_File', $config{ 'database' } or die "Cannot open file $config{'database'} $!\n";

    if ( $action eq 'get' ) {
      return $database{ $type };
    } elsif ( $action eq 'set' ) {

        # Shuffle recently viewed list, dropping 6th item from list.
        if ( $type eq 'current' ) {
            $database{ 'old4' }    = $database{ 'old3' };
            $database{ 'old3' }    = $database{ 'old2' };
            $database{ 'old2' }    = $database{ 'old1' };
            $database{ 'old1' }    = $database{ 'current' };
            $database{ 'current' } = $value;
        } else {
            $database{ $type } = $value;
          return undef;
        }
    } ## end elsif ( $action eq 'set' )

    untie %database;
} ## end sub datastore

=item * getdir

Getfiles simply gets the contents of a directory and returns an array of
filenames, minus . and ..  It assumed that only photos will be in your wallpaper
directories, so it doesn't do any further filtering.  If any subdirectories are
found, it will recurse through them as well - but only to one level.

This function accepts only one parameter, the full path to scan.  It returns an
array of filenames.

=cut

sub getdir {
    my ( $dir ) = @_;
    my (@filter, @return);

    opendir( DIR, $dir ) || die "can't opendir $dir: $!";
    my @list = readdir( DIR );
    closedir DIR;
    
    for my $item ( @list ) {
        push (@filter, $item) unless ( ($item eq ".") or ($item eq "..") );
    }

    for my $list ( @filter ) {
        push( @return, $list ) if ( -f $dir . "/" . $list );

        # sub directory found, so lets recurse it 1x
        if ( -d $dir . "/" . $list ) {
            opendir( SUBDIR, $dir . "/" . $list ) || die "can't opendir " . $dir . "/" . $list . ": $!";
            my @sublist = readdir( SUBDIR );
            closedir SUBDIR;
            shift( @sublist );    # Drop . and ..
            shift( @sublist );
            for my $sublist ( @sublist ) {
                push( @return, $list . "/" . $sublist ) if ( -f $dir . "/" . $list . "/" . $sublist );
            }
        } ## end if ( -d $dir . "/" . $list)

    } ## end for my $list ( @list )
    my $numreturn = scalar @return;
    print "\t\tThere are $numreturn files to pick from in $dir...\n" if $config{ 'debug' };
  return @return;
} ## end sub getdir

=item * randomfile

randomfile selects a random file from an array of filename.  It favors newer
files, and does so in the following manner.

First, all the files in the array have their timestamps read.  Each file +
timestamp is inserted into %firsthash.  %firsthash is then sorted, (by file
timestamp), and each file is re-inserted into %secondhash this time with a rank
multiplier.  So the oldest file gets a rank of 1, and if you have 20 files, the
newest is ranked 20.

Finally, %secondhash is parsed, and each file is inserted into a final selection
array.  It's reinserted over and over until it's rank decreases to zero.  This
means that your newest file is in the array 20 times (and your oldest 1 time).

Finally, we pick a file from the array at random.  Since we've stuffed the array
with many duplicates, newer files are chosen more often, and older files chosen
less often.

This works, but there *HAS* to be a better way of doing this.  PLEASE email me
any suggestions you have have.

This function accepts two parameters, an array of files to pick from, and the
"current" file being displayed.  It returns the new randomly selected photo
(with path).

=cut

sub randomfile {
    print "Getting Random File\n" if $config{ 'debug' };
    my @inhash  = @{ $_[0] };
    my $current = $_[1];

    my ( @files, $new, %firsthash, %secondhash, $ranking );

    # Fetch previous photos we have displayed from the datastore.
    my @badphotos = ( &datastore( 'get', 'old4' ),
                      &datastore( 'get', 'old3' ),
                      &datastore( 'get', 'old2' ),
                      &datastore( 'get', 'old1' ),
                      &datastore( 'get', 'current' ), $current
                    );

    print "\tFirst Run, Getting Filetimes:\n" if $config{ 'debug' };
    for my $file ( @inhash ) {
        my $timestamp = &getfiletime( $file );

        my $ref = $firsthash{ $timestamp };
        $ref->{ 'age' }          = &getfiletime( $file );
        $ref->{ 'name' }         = $file;
        $firsthash{ $timestamp } = $ref;
        print "\t\t$ref->{'age'} $ref->{'name'}\n" if $config{ 'debug' };
    } ## end for my $file ( @inhash )

    print "\tSecord Run, Ranking Files:\n" if $config{ 'debug' };
    foreach my $ref ( sort keys %firsthash ) {
        $ranking++;
        my $rank = sprintf( "%.3d", $ranking );
        my $hashfile = $firsthash{ $ref }{ 'name' };

        my $ref = $secondhash{ $hashfile };
        $ref->{ 'rank' }         = $rank;
        $ref->{ 'name' }         = $hashfile;
        $secondhash{ $hashfile } = $ref;
        print "\t\t$ref->{'rank'} $ref->{'name'}\n" if $config{ 'debug' };
    } ## end foreach my $ref ( sort keys...

    print "\tThird Run, Creating the BIG array\n" if $config{ 'debug' };
    while ( my ( $source, $hashes ) = each %secondhash ) {
        my $times = $hashes->{ 'rank' };
        my $rank;
        print "\t\t$source inserted into array $times times\n" if $config{ 'debug' };
        while ( $times > $rank++ ) {
            push( @files, $source );
        }
    } ## end while ( my ( $source, $hashes...

    print "\tPicking a random item from the BIG array (size: $#files elements)\n" if $config{ 'debug' };
    while ( 1 ) {
        my $index = rand @files;
        $new = $files[$index];
      last unless ( &comparelist( \@badphotos, $photodir . $new ) );
    }

    print "\tRandomly selected new photo is $new \n" if $config{ 'debug' };
  return $new;
} ## end sub randomfile

=item * comparelist

Simple little function to compare a list of photos to a given photo, and return
true if there is a match.  Used to filter out photos that have been displayed
recently.

Two parameters, an array of "bad photos", and the current photo to compare to
the list of badphotos.  If a match is found, true is returned.  Otherwise it
returns nothing.

=cut

sub comparelist {
    my @badphotos = @{ $_[0] };
    my $selected  = $_[1];

    for my $photo ( @badphotos ) {
        if ( $photo eq $selected ) {
            print "$photo matches $selected, picking a new file ...\n" if $config{ 'debug' };
          return 1;
        }
    }
  return undef;

} ## end sub comparelist

=item * getscheme

getscheme retrieves the Red, Green, and Blue Means.  It then combines these,
divides by three to determine if an image is bright or not.  It then makes some
choices about how to pick a scheme, finally creates one.

getscheme's last task is to launch conkytweak.

It accepts one parameter, a reference to the imagemagick object to inspect.  It
returns a hash of arrays which contain the selected scheme.

=cut

sub getscheme {
    print "\nSelecting a color palate to work with:\n" if $config{ 'debug' };
    my ( $image ) = @_;
    my ( $basecolor, $return );

    my $filename = $image->Get( 'filename' );    # Get the image filename (used later)

    # Returned = (for reference)
    # 0  - Red Depth
    # 1  - Red Minima
    # 2  - Red Maxima
    # 3  - Red Mean
    # 4  - Red Deviation
    # 5  - Blue Depth
    # 6  - Blue Minima
    # 7  - Blue Maxima
    # 8  - Blue Mean
    # 9  - Blue Deviation
    # 10 - Green Depth
    # 11 - Green Minima
    # 12 - Green Maxima
    # 13 - Green Mean
    # 14 - Green Deviation

    my @statistics = $image->Statistics();                                        # Retrieve the above stats
    my $red        = $statistics[3];
    my $green      = $statistics[8];
    my $blue       = $statistics[13];
    my $avg        = ( $statistics[3] + $statistics[8] + $statistics[13] ) / 3;

    # Image Preset Overrides if RGB color is embedded in filename

    if ( $filename =~ /_#/ ) {
        ( $basecolor ) = $filename =~ /_#(.*)_/;
        print "\n\tPreset Override with $basecolor!" if $config{ 'debug' };
        $avg = 1;                                                                 # Bypass tests
    }

    # Some images return RGB colors in 16 bit instead of 256, so lets convert
    # them back into normal values.

    if ( $avg > 255 ) {
        $red   = $red / 254;
        $green = $green / 254;
        $blue  = $blue / 254;
        $avg   = ( $red + $blue + $green ) / 3;
    }

    print "\n\tSetting Brightness ...\n" if $config{ 'debug' };

    # Photo is white, or white enough that we are going to manually preset the
    # background color.  This is a hack to create good looking schemas when we
    # do not have enough color information to create one.

    if ( $avg > 200 ) {
        my $index = rand scalar @{ $config{ 'schema_preset' } };    # schemapreset;
        $basecolor = $config{ 'schema_preset' }[$index];
        $avg       = 1;
        print "\tBackground is white, setting background to a random preset\n" if $config{ 'debug' };
    }

    # Really bright photos completly hose our color scheme selections process,
    # so we loop through all the rgb values until the mean falls below our
    # "brightness" theshold.  By reducing every value at once we "preserve" the
    # base color ratio, and thus end up with an acceptable shade to work with.

    while ( $avg > 130 ) {
        $red--;
        $green--;
        $blue--;
        $avg--;
        print "\t\ttoo bright, reducing mean by 1 : $red, $green, $blue, $avg\n" if $config{ 'debug' };
    }

    print "\tRed Mean: $red\n"     if $config{ 'debug' };
    print "\tGreen Mean: $green\n" if $config{ 'debug' };
    print "\tBlue Mean: $blue\n"   if $config{ 'debug' };
    print "\tAvg Mean: $avg\n"     if $config{ 'debug' };

    # Set border basecolor only if $basecolor has not allready been defined
    # above

    if ( !$basecolor ) {
        $basecolor = sprintf( "%02X%02X%02X\n", $red, $green, $blue );    # Convert Base 256 rgb color mean to base16 (hex)
    }
    print "\tSelected Base color of image is $basecolor\n" if $config{ 'debug' };

    my $scheme = Color::Scheme->new;                                      # New Scheme Object
    $scheme->from_hex( $basecolor );                                      # Use our base photo color as a starting point
    $scheme->scheme( 'analogic' );                                        # Select a scheme type, also mono, contrast, triad, tetrade, analogic
    $scheme->add_complement( 1 );                                         # Add complemently colors to hash for analogic scheme

  return $scheme->colorset;

} ## end sub getscheme

=item * conkytweak

conkytweak basicly reads a conky configuration file, and replaces "keywords" in
it with actual color names, which have been picked out for us and are in our
scheme.  The following "keywords" can be used in your conky template.

 BRIGHTCOLOR    - Used for section "titles"
 DIMCOLOR       - Used for section "text"
 SHADOWCOLOR    - Text Shadows
 SHADECOLOR     - Graph outline shadows
 OUTLINECOLOR   - Graph outlines and HR bars
 BARSTART       - Graph start color
 BAREND         - Graph end color

conkytweak has no parameters and no return value.

=cut

sub conkytweak {
    print "Tweaking Conky Configuration\n" if $config{ 'debug' };

    $colorscheme = getscheme( $image->[0] ) if ( !$colorscheme );    # Get a color scheme if we dont have it allready

    my ( $brightcolor, $dimcolor, $shadowcolor, $shadecolor, $outlinecolor, $barcolor, $barstart, $barend );

    # Handy Names
    # The 0 array is the scheme used for the original picture.
    # the 1 array is a "cooler" scheme
    # the 2 array is a "warmer" scheme
    # the 3 array is the complementary scheme

    # $colorscheme->[0][0] = most saturated color (typically mean color of photo
    # $colorscheme->[0][1] = darkened color
    # $colorscheme->[0][2] = pale color
    # $colorscheme->[0][3] = less pale color

    $brightcolor = $colorscheme->[0][3];    # Pale Comp Color (for section titles)
    $dimcolor    = $colorscheme->[0][2];    # Less Pale Comp Color (for section text)

    $shadowcolor = $colorscheme->[0][1];    # Text Shadows use same color as picture border
    $shadecolor  = $colorscheme->[0][1];    # Graph outline shading uses the same color as picture border

    $outlinecolor = $colorscheme->[1][1];   # Graph outline and hr div color is base color of complementary scheme

    $barcolor = $colorscheme->[2][2];       # Color 'normal' bars use is comp base
    $barstart = $colorscheme->[1][1];       # Nice warm contrasting color (dark)
    $barend   = $colorscheme->[1][2];       # Nice warm contrasting color (light)

    # Read our template
    open( INPUT, "<" . $config{ 'conky_template' } );
    my @lines = <INPUT>;
    close INPUT;

    # Ande create our new conky config.
    open( OUTPUT, ">" . $config{ 'conky_out' } );
    foreach my $line ( @lines ) {
        $line =~ s/BRIGHTCOLOR/$brightcolor/g;
        $line =~ s/DIMCOLOR/$dimcolor/g;

        $line =~ s/SHADOWCOLOR/$shadowcolor/g;
        $line =~ s/SHADECOLOR/$shadecolor/g;

        $line =~ s/OUTLINECOLOR/$outlinecolor/g;
        $line =~ s/BARCOLOR/$barcolor/g;
        $line =~ s/BARSTART/$barstart/g;
        $line =~ s/BAREND/$barend/g;

        print OUTPUT "$line";
    } ## end foreach my $line ( @lines )
    close OUTPUT;

    print "\tWrote new Conky config at $config{'conky_out'} with the following schema:\n" if $config{ 'debug' };
    print "\t\tBRIGHTCOLOR: $brightcolor\n"                                               if $config{ 'debug' };
    print "\t\tDIMCOLOR: $dimcolor\n"                                                     if $config{ 'debug' };
    print "\t\tSHADOWCOLOR: $shadowcolor\n"                                               if $config{ 'debug' };
    print "\t\tSHADECOLOR: $shadecolor\n"                                                 if $config{ 'debug' };
    print "\t\tOUTLINECOLOR: $outlinecolor\n"                                             if $config{ 'debug' };
    print "\t\tBARCOLOR: $barcolor\n"                                                     if $config{ 'debug' };
    print "\t\tBARSTART: $barstart\n"                                                     if $config{ 'debug' };
    print "\t\tBAREND: $barend\n"                                                         if $config{ 'debug' };

    # DB_File doesn't handle complex data structures (like a multidimensional
    # hash), so we'll store the entire scheme in a colon seperated list.  Pull
    # the data back out with a script argument of --scheme or --schemedata.

    &datastore( 'set',
                'scheme',
                $colorscheme->[0][0] . ":"
                  . $colorscheme->[0][1] . ":"
                  . $colorscheme->[0][2] . ":"
                  . $colorscheme->[0][3] . ":"
                  . $colorscheme->[1][0] . ":"
                  . $colorscheme->[1][1] . ":"
                  . $colorscheme->[1][2] . ":"
                  . $colorscheme->[1][3] . ":"
                  . $colorscheme->[2][0] . ":"
                  . $colorscheme->[2][1] . ":"
                  . $colorscheme->[2][2] . ":"
                  . $colorscheme->[2][3] . ":"
                  . $colorscheme->[3][0] . ":"
                  . $colorscheme->[3][1] . ":"
                  . $colorscheme->[3][2] . ":"
                  . $colorscheme->[3][3]
              );

    print "\tGiving conky a whack to reload its config ..." if $config{ 'debug' };
    system( "killall -SIGUSR1 conky" );    # Tell conky to reread its config

} ## end sub conkytweak

=item * sanity_check

Function to ensure that everything is kosher before starting up image manipulation
routines.  It has no parameters and returns nothing.  It does kill the script off
if it finds something wrong. :)

=cut

sub sanity_check {

    # Check for a conky tiled background image
    if ( !-e $config{ 'bgdir' } . '/backtile.jpg' ) {
        die "No conky background tile photo found!  Download a tiling photo and save it as $config{'bgdir'}/backtile.jpg\n";
    }

    # Check for blank working image
    if ( !-e $config{ 'bgdir' } . '/blank.png' ) {
        die "No blank photo file found!, create a 1x1 blank photo and save it as $config{'bgdir'}/blank.png\n";
    }

    # Check for conky template
    if ( !-e $config{ 'conky_template' } ) {
        die "No conky template found, create one in $config{'conky_template'}\n";
    }

    # Check for database
    if ( !-e $config{ 'database' } ) {
        my @toselect1 = getdir( $photodir );                    # Get a list of files to choose from
        my $selected1 = randomfile( \@toselect1, $current );    # Pick a new image for upcoming photo
        my $current   = $photodir . $selected1;                 # Full path to new image
        &datastore( 'set', 'current', $current );               # Record current filename
        my @toselect2 = getdir( $photodir );                    # Get a list of files to choose from
        my $selected2 = randomfile( \@toselect2, $current );    # Pick a new image for upcoming photo
        my $next      = $photodir . $selected2;                 # Full path to new image
        &datastore( 'set', 'next', $next );                     # Record current filename
        print "no current database file found so I chose a $current to display right now and $next to display next...\n";

    } ## end if ( !-e $config{ 'database'...

    # Ensure we have enough files for randomization
    for my $index ( qw/1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23/ ) {
        my @files  = getdir( $config{ 'bgdir' } . "/" . $config{ 'photoset' }[$index] );
        my $number = scalar @files + 1; # array item 0 = file # 1 (bah!)
        if ( $number < 7 ) {
            print "You need at least 6 files in $config{'bgdir'}/$config{'photoset'}[$index] !\n";
            die( "FATAL ERROR: Killing script in order prevent a possible race condition\n" );
        }
    } ## end for my $index ( qw/1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23/)

} ## end sub sanity_check

=item * setdefaults

setdefaults sets all the configuration defaults, and if a user config file is
present, it will read it and overwrite the defaults.

See the configuration for a description of configuration options.

This function has no parameters and returns nothing.  However, by the finish
of this function - a full populated %config hash should be present.

Ideas?

shared config options
  debug
  exe_scale
  exe_tile
  bgdir
  database
  photoset
  schema_preset

display config options [0] or [0][1], but plain var should work on one
display.

  resolution
  conky
  urxvt_pixmaps
  mangle
  displayfont
  fontsize
  font_x
  font_y
  collage_text
  collage_container_geo
  collage_photo_geo
  collage_border1_geo
  collage_border1_col
  collage_border2_geo
  collage_border2_col
  border_size
  bar_height
  conky_width
  urxvt_theme_op
  urxvt_black_op
  urxvt_blur
  conky_template
  conky_out

=cut

sub setdefaults {

    %config = (
        debug                 => "0",
        conky                 => "0",
        urxvt_pixmaps         => "0",
        mangle                => "0",
        display               => "DISPLAY=:0.0",
        resolution            => "1024x768",
        exe_scale             => "feh --bg-scale",
        exe_tile              => "feh --bg-tile",
        bgdir                 => "$ENV{HOME}/.backgrounds",
        database              => "/dev/shm/wallpaper.db",
        displayfont           => "/usr/share/fonts/TTF/Vera.ttf",
        fontsize              => "15",
        font_x                => "30",
        font_y                => "270",
        collage_text          => "... the next background will be ...",
        collage_container_geo => "!315x250",
        collage_photo_geo     => "!265x200",
        collage_border1_geo   => "5x5",
        collage_border1_col   => "white",
        collage_border2_geo   => "1x1",
        collage_border2_col   => "grey40",
        border_size           => "2",
        bar_height            => "26",
        conky_width           => "342",
        urxvt_theme_op        => "60",
        urxvt_black_op        => "70",
        urxvt_blur            => "5",
        conky_template        => "$ENV{HOME}/.conkyrc.template",
        conky_out             => "$ENV{HOME}/.conkyrc",
        schema_preset         => [ "232328", "003f63", "ab5623" ],
        photoset              => [
                      "Early",          "Early",        "Early",        "Early",     "Early",         "Morning",
                      "Food/Breakfast", "Morning",      "Morning",      "Morning",   "Work/Arriving", "Work/Arriving",
                      "Food/Lunch",     "Work/Hacking", "Work/Hacking", "Afternoon", "Afternoon",     "Afternoon",
                      "Food/Dinner",    "Evening",      "Evening",      "Evening",   "Evening",       "Evening"
                    ]

              );

    # Now we have global settings, lets read in our user's config.
    if ( -e "$ENV{'HOME'}/.wallrc" ) {
        open( CONFIG, "$ENV{'HOME'}/.wallrc" );
        while ( <CONFIG> ) {
          next if /^\s*#/ or /^\s*$/;
            my ( $opt, $val ) = $_ =~ /^(.*)\s+\=\s+\"(.*)\"/;
            $opt =~ s/\ //g;

            # Handle Schema array (in config file as one variable, values space
            # delimited)
            if ( $opt =~ /^schema_preset/ ) {
                my $string;
                my @array = split( '\s', $val );
                $config{ $opt } = \@array;

                # Handle photoset array (in config file, a bunch of options)
            } elsif ( $opt =~ /^photoset/ ) {
                my ( undef, $num ) = split( '_', $opt );
                $config{ 'photoset' }[$num] = $val;

                # Looks like a regular option.
            } else {
                my ( $opt, $val ) = $_ =~ /^(.*)\s+\=\s+\"(.*)\"\n/;
                $config{ $opt } = $val;
            }

        } ## end while ( <CONFIG> )
        close( CONFIG );
    } ## end if ( -e "$ENV{'HOME'}/.wallrc")

    # Now print the option back out if there's a debug condition.
    if ( $config{ 'debug' } ) {
        print "Configuration options are:\n";
        foreach my $opt ( keys %config ) {
            if ( $opt =~ /^schema_preset|^photoset/ ) {
                print "\t$opt @ [ ";
                for my $list ( @{ $config{ $opt } } ) {
                    print "$list ";
                }
                print "]\n";
            } else {
                print "\t$opt = $config{$opt}\n";
            }
        } ## end foreach my $opt ( keys %config)
    } ## end if ( $config{ 'debug' ...
} ## end sub setdefaults

=item * getfiletime

A simple function to return the last modified timestamp of a file.

Parmeter is a file, returns last modifed time.

=cut

sub getfiletime {
    my ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks ) = stat( $photodir . $_[0] );
  return $mtime;
}

=item * rotate

rotate simply returns a random number between 15 and 7.  It's used to provide a
rotation amount for the next photo collage.

Accepts no parameters, returns a number between 15 and 7.

=cut

sub rotate {
    my $degrees = rand() * 15 - 7;
  return $degrees;
}

=back 

=head1 COMMANDLINE ARGUMENTS

    --photo /full/path/to/photo.jpg

Passing --photo and a full path to an image will manually set the background
right away, bypassing the stopfile.

    --toggle 

enables and disables "normal" script processing.
    
    --status

shows to toggle status.

    --scheme

shows the current color scheme in use (in human readable format)

    --schemedata

shows the current color scheme in use (in script friendly format)

=cut

sub checkargs {
    my @args    = @_;
    my $numargs = scalar @_;

    &displayhelp if ( $numargs > 2 );
    &displayhelp if ( $args[0] =~ /\?|\-?\-help|\-h/ );

    my $command = shift( @args );

    if ( $command eq "--status" ) {
        my $status = &datastore( 'get', 'status' );
        print "Status is : $status\n";
        exit( 0 );
    } elsif ( $command eq "--toggle" ) {
        my $status = &datastore( 'get', 'status' );
        if ( $status eq "stop" ) {
            &datastore( 'set', 'status', 'run' );
            print "This script is now set to generate new wallpapers\n";
        } else {
            &datastore( 'set', 'status', 'stop' );
            print "This script has been halted and will not generate new wallpapers\n";
        }
        exit( 0 );
    } elsif ( $command eq "--schemedata" ) {
        my $scheme = &datastore( 'get', 'scheme' );
        print "$scheme\n";
        exit( 0 );
    } elsif ( $command eq "--scheme" ) {
        my $scheme = &datastore( 'get', 'scheme' );
        my @colors = split( ':', $scheme );
        print "Basic Colors\n";
        print "\tBase      : $colors[0]\n";
        print "\tDark      : $colors[1]\n";
        print "\tPale      : $colors[2]\n";
        print "\tLess Pale : $colors[3]\n";
        print "Cool Colors\n";
        print "\tBase      : $colors[4]\n";
        print "\tDark      : $colors[5]\n";
        print "\tPale      : $colors[6]\n";
        print "\tLess Pale : $colors[7]\n";
        print "Warm Colors\n";
        print "\tBase      : $colors[8]\n";
        print "\tDark      : $colors[9]\n";
        print "\tPale      : $colors[10]\n";
        print "\tLess Pale : $colors[11]\n";
        print "Complementary Colors\n";
        print "\tBase      : $colors[12]\n";
        print "\tDark      : $colors[13]\n";
        print "\tPale      : $colors[14]\n";
        print "\tLess Pale : $colors[15]\n";
        exit( 0 );
    } elsif ( $command eq "--photo" ) {
        my $param = shift( @args );
        die( "Photo $param does not exist" ) if ( !-e $param );

        print "Photo $param manually selected!\n" if $config{ 'debug' };

        &datastore( 'set', 'current', $param );    # Record the current filename
        my @toselect = getdir( $photodir );        # Get a list of files to choose from
        $selected = randomfile( \@toselect, $param );    # Pick a new image for upcoming photo
        $next = $photodir . $selected;                   # Full path to new image
        &datastore( 'set', 'next', $next );              # Set the next photo to use next run

        &chooser( $param, $next );

    } ## end elsif ( $command eq "--photo")

    exit( 0 );

    sub displayhelp {
        die( "Valid arguments are --photo followed by a FULL patthname, --toggle, --status, --scheme, or --schemedata\n" );
    }

} ## end sub checkargs

1;

__END__

=head1 AUTHOR

Charles Mauch <cmauch@gmail.com>

=head1 LICENSE

Copyright (c) 2006 Charles Mauch

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any later
version.

This program is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.  See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
Street, Fifth Floor, Boston, MA  02110-1301, USA.

=head1 SEE ALSO

perl(1).

=cut

1;

# $Id: wallpaper 129 2006-10-24 04:59:41Z cmauch $
